home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Belgian Amiga Club - ADF Collection
/
BS1 part 26.zip
/
BS1 part 26
/
The Director Toolkit v1.0.adf
/
Programs
/
Text
/
docread
< prev
next >
Wrap
Text File
|
1987-02-25
|
6KB
|
300 lines
rem text reader
getok=1000:clears=1100:docmd=1200:getevent=1300
font=1:clr=3
charw=8
charh=10
cent=0
styl=0
spac=0
esc=124 :rem the | signal character
xmax=610
ymax=180
xmin=20
ymin=28
eof=0
load 1,"Toolkit:pictures/framer" :rem you may have to adjust this
array 500,4
temp=100
pstart=temp+50
page=pstart
@(page)=0
abort 0
loadfont 1,8,"topaz.font"
loadfont 2,9,"topaz.font"
setfont font
pen 1,clr
margins xmin,xmax
mode=0
open mode,"docs"
if mode=0
center 1
move 0,100
pen 1,6
setfont 2
text "Can't open docs file"
gosub getok
end
endif
rem top of page
8
location v
@(page)=v :rem remember top of page
page=page+1
gosub clears
rem next line
10 read v,$(0),90
if v=-1:goto 22:endif
in=0
if @(in)=0 :rem newline
xloc=xmin
yloc=yloc+charh
if yloc > ymax
gosub getevent
endif
goto 10
endif
rem proc any commands
11
if @(in)=32:in=in+1:goto 11:endif :rem ignore leading spaces
if @(in)=0:goto 10:endif :rem eol
if @(in)=esc
gosub docmd
goto 11
endif
word=in :rem beginning of section
rem find end of section
12 c=@(in)
if c#esc & c#0
in=in+1
goto 12
endif
@(in)=0
rem proc section
13
if @(in-1)=32 :rem ignore trailing spaces
@(in)=c
in=in-1
c=@(in)
@(in)=0
goto 13
endif
sectw=(charw+spac)*(in-word)
rem output a section
if (xloc+sectw)<xmax
sp=1
t=@(in-1)
if t=46 | t=33 | t=63 :rem . ! ?
sp=2
endif
t=(xmax-(xloc+sectw))/(charw+spac)
sp=sp_t
center cent
move xloc,yloc
pen 1,clr
text $(word);
xloc=xloc+sectw+sp*(charw+spac)
if cent :rem centering forces newline
xloc=xmin
yloc=yloc+charh
if yloc > ymax
gosub getevent
endif
endif
center 0
@(in)=c :rem restore terminator
goto 11
endif
rem section's too big, find subsection
t=0~((xmax-xloc)/(charw+spac)-1) :rem compute max chars
14 if t=0 :rem too near end of line
yloc=yloc+charh
if yloc > ymax
gosub getevent
endif
xloc=xmin
goto 13 :rem retry this section on next line
endif
if @(word+t)#32 :rem find word break
t=t-1
goto 14 :rem keep moving
endif
rem found space break
@(in)=c
in=word+t
c=@(in)
@(in)=0
goto 13 :rem process shortened section
rem getok
1000
center 0
pen 1,7
move 306,154
setfont 1
text "OK"
pen 1,4
move 295,145
draw 295,157
draw 332,157
draw 332,145
draw 295,145
1001
getmouse x,y
if x>295 & x<332 & y>145 & y<157
pen 1,0
rect 295,145,332,157
return
else
drawmode 2
pen 1,7
rect 295,145,332,157:pause 1
rect 295,145,332,157
goto 1001
endif
setfont font
return
rem clears
1100
xloc=xmin:yloc=ymin
pen 1,0
rect 5,17,633,182
pen 1,clr
return
rem docmd
1200
in=in+1
@(temp+1)=0
if @(in)=99 :rem 'c' for color
in=in+2
@(temp)=@(in-1)
clr=$(temp)
pen 1,clr
return
endif
if @(in)=102 :rem 'f' for font
in=in+2
@(temp)=@(in-1)
font=$(temp)
setfont font
if font=2
charw=10
else
charw=8
endif
return
endif
if @(in)=116 :rem 't' for centering
in=in+2
@(temp)=@(in-1)
cent=$(temp)
return
endif
if @(in)=114 :rem 'r' for forced return
in=in+2
@(temp)=@(in-1)
rets=$(temp)
xloc=xmin
yloc=yloc+charh*rets
if yloc > ymax
gosub getevent
endif
return
endif
if @(in)=115 :rem 's' for style
in=in+3
@(temp)=@(in-2)
styl=$(temp)
@(temp)=@(in-1)
spac=$(temp)
style styl,spac
return
endif
if @(in)=101 :rem 'e' for end of page
in=in+1
goto getevent :rem await page click
endif
if @(in)=esc :rem use || to output a |
in=in+1
move xloc,yloc
text "|";
sps=1
goto 1222 :rem act like space from here
endif
if @(in)=45 :rem '-' for backspace
in=in+1
xloc=(xloc-charw)~xmin
return
endif
if @(in)=43 :rem '+' for required spaces
in=in+2
@(temp)=@(in-1)
sps=$(temp)
if sps=0:sps=10:endif
1222
xloc=xloc+charw*sps
if xloc>xmax
xloc=xmin
yloc=yloc+charh
if yloc > ymax
gosub getevent
endif
endif
return
endif
return
rem eof - handle backup from here as well
22 eof=1
gosub getevent
goto 10 :rem next line
rem getevent
1300
getmouse x,y
rem quit box...
if x>9 & x<22 & y>4 & y<9
end
endif
rem bkwd page
if x>243 & x<301 & y>184 & y<197
page=(page-2)~pstart
seek @(page)
page=page+1
eof=0
gosub clears
return
endif
if eof
eof=0
return
endif
rem fwd page
location v
@(page)=v :rem remember top of page location
page=page+1
gosub clears
return